# load omnibus dataframe
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
omnibus_df <- read_delim("../data/processed/omnibus/omnibus_raw.csv",
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
delim = ",",
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
col_types = cols(
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
.default = col_double(),
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
type = col_factor(),
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
ppid = col_factor(),
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
exp_label = col_factor(),
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
experiment = col_factor(),
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
hand = col_factor(),
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
camera_tilt = col_factor(),
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
surface_tilt = col_factor(),
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
target = col_factor(),
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
test_type = col_factor(),
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
prior_anim = col_factor(),
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
baseline_block = col_factor(),
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
task_type = col_factor(),
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
surface = col_factor(),
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
anim_type = col_factor()
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
)
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
) %>% # filter out practice blocks
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
filter(block_num > 4)
Error in exists(cacheKey, where = .rs.WorkingDataEnv, inherits = FALSE) :
invalid first argument
Error in assign(cacheKey, frame, .rs.CachedDataEnv) :
attempt to use zero-length variable name
# Optionally compute learning rate fits
# Do the following if learning_rate_df.csv doesn't exist in ../data/processed
# This takes a loong time
if (!file.exists("../data/processed/learning_rate_df.csv")) {
print(Sys.time())
apply_exponential_fit <- function(df) {
df %>%
summarise(
ppid = first(ppid),
experiment = first(experiment),
test_type = first(test_type),
exponentialFit = exponentialFit(
norm_throw_deviation,
mode = test_type[1]
)
)
}
init_learning_rates <- omnibus_df %>%
filter(str_detect(test_type, "init")) %>%
group_by(ppid, experiment, test_type) %>%
group_split() %>%
future_map(apply_exponential_fit) %>%
bind_rows() %>%
unnest(cols = c("exponentialFit"))
print("done 2 param fits")
print(Sys.time())
write_csv(init_learning_rates, "../data/processed/learning_rate_df.csv")
# repeat using exponentialFit_3par
apply_exponential_fit_3par <- function(df) {
df %>%
summarise(
ppid = first(ppid),
experiment = first(experiment),
test_type = first(test_type),
exponentialFit = exponentialFit_3par(
norm_throw_deviation,
mode = test_type[1]
)
)
}
init_learning_rates_3par <- omnibus_df %>%
filter(str_detect(test_type, "init")) %>%
group_by(ppid, experiment, test_type) %>%
group_split() %>%
future_map(apply_exponential_fit_3par) %>%
bind_rows() %>%
unnest(cols = c("exponentialFit"))
print("done 3 param fits")
print(Sys.time())
write_csv(
init_learning_rates_3par,
"../data/processed/learning_rate_df_3par.csv"
)
} else {
print("learning_rate_df.csv exists, loading from file")
init_learning_rates <- read_csv(
"../data/processed/learning_rate_df.csv",
col_types = cols(
.default = col_double(),
experiment = col_factor(),
test_type = col_factor()
)
)
init_learning_rates_3par <- read_csv(
"../data/processed/learning_rate_df_3par.csv",
col_types = cols(
.default = col_double(),
experiment = col_factor(),
test_type = col_factor()
)
)
}
[1] "learning_rate_df.csv exists, loading from file"
Vectors representing the throw velocity (trace 0) and the velocity applied to the ball (trace 1). The y dimention of the throw is essentially ignored (in reality there is a slight tilt added to account for the tilt of the surface).
test_ppt <- 3
test_df <- omnibus_df %>% filter(ppid == test_ppt)
trial <- 250
trial_df <- filter(test_df, trial_num == trial)
x <- trial_df$flick_velocity_x
y <- trial_df$flick_velocity_y
z <- trial_df$flick_velocity_z
x2 <- trial_df$flick_direction_x * -1
y2 <- trial_df$flick_direction_y * -1
z2 <- trial_df$flick_direction_z * -1
# plot both
p <- plot_ly(
x = c(0, x), y = c(0, y), z = c(0, z),
type = "scatter3d", mode = "lines"
) %>%
add_trace(
x = c(0, x2), y = c(0, y2), z = c(0, z2),
type = "scatter3d", mode = "lines"
) %>%
layout(scene = list(
xaxis = list(title = "x", range = c(-2, 2)),
yaxis = list(title = "y", range = c(-1, 3)),
zaxis = list(title = "z", range = c(-1, 3)),
aspectmode = "cube" # equal aspect ratios
))
# Render the plot
p
rm(trial_df)
note: this is a rotated trial
# plot distribution of error_size
p <- ggplot(omnibus_df, aes(
x = error_size,
fill = type
)) +
geom_histogram(binwidth = .5, alpha = .6) +
theme_minimal() +
theme(text = element_text(size = 11)) +
scale_fill_manual(values = c("#f9982c", "#d40000")) +
labs(x = "Error Size (cm)", y = "Count")
p
# plot distribution of error_size
p <- ggplot(omnibus_df, aes(
x = throw_deviation,
fill = type
)) +
geom_histogram(binwidth = 1, alpha = .6) +
theme_minimal() +
theme(text = element_text(size = 11)) +
scale_fill_manual(values = c("#f9982c", "#d40000")) +
labs(
x = "Throw Angle (°)", y = "Count"
) + # dashed lines at 0, -15, -30
geom_vline(
xintercept = c(0, -15, -30), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
) + # ticks of 15 degrees
scale_x_continuous(
breaks = c(-30, 0, 30, -60, -90)
)
p
Note: Blues = Acceleration Perturbations
# rest of the exps
data_per_group <- omnibus_df %>%
filter(exp_label == "original_exps" | exp_label == "curved_path") %>%
group_by(experiment, test_type, trial_num) %>%
summarise(
mean_deviation = mean(throw_deviation),
ci_deviation = vector_confint(throw_deviation),
.groups = "drop"
)
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = trial_num, y = mean_deviation, colour = experiment
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Throw Angle (°)"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, -30), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(-15), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# set font size to 11
p <- p +
theme(text = element_text(size = 11))
# add confidence intervals and data points
p <- p + geom_ribbon(
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation,
fill = experiment
),
colour = NA, alpha = 0.3
) + geom_line()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# p
Note: Blues = Acceleration Perturbations
# filter out just the trials of interest
data_per_group <- data_per_group %>%
filter(
test_type != "other"
)
# add a dummy column with repeating sequence
# NOTE: this can't be combined with above since we are using nrow
data_per_group <- data_per_group %>%
mutate(dummy_x = rep(1:(nrow(data_per_group) / num_exps),
length.out = nrow(data_per_group)
))
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = dummy_x, y = mean_deviation, colour = experiment
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Throw Angle (°)"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, -30), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(-15), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# add confidence intervals and data points
for (unique_test_type in unique(data_per_group$test_type)) {
# get the data for this block
to_plot_data <- filter(data_per_group, test_type == unique_test_type)
p <- p + geom_ribbon(
data = to_plot_data,
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation,
fill = experiment
), colour = NA, alpha = 0.3
) + geom_line(
data = to_plot_data
)
}
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
Note: Blues = Acceleration Perturbations
# rest of the exps
data_per_group <- omnibus_df %>%
filter(exp_label == "original_exps" | exp_label == "curved_path") %>%
group_by(experiment, test_type, trial_num) %>%
summarise(
mean_deviation = mean(norm_throw_deviation),
ci_deviation = vector_confint(norm_throw_deviation),
.groups = "drop"
)
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = trial_num, y = mean_deviation, colour = experiment
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Normalized Throw Angle"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, 1, 2), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(0.5, 1.5), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# set font size to 11
p <- p +
theme(text = element_text(size = 11))
# add confidence intervals and data points
p <- p + geom_ribbon(
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation,
fill = experiment
),
colour = NA, alpha = 0.3
) + geom_line()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# p
Note: Blues = Acceleration Perturbations
# filter out just the trials of interest
data_per_group <- data_per_group %>%
filter(
test_type != "other"
)
# add a dummy column with repeating sequence
# NOTE: this can't be combined with above since we are using nrow
data_per_group <- data_per_group %>%
mutate(dummy_x = rep(1:(nrow(data_per_group) / num_exps),
length.out = nrow(data_per_group)
))
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = dummy_x, y = mean_deviation, colour = experiment
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Normalized Throw Angle"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, 1, 2), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(0.5, 1.5), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# add confidence intervals and data points
for (unique_test_type in unique(data_per_group$test_type)) {
# get the data for this block
to_plot_data <- filter(data_per_group, test_type == unique_test_type)
p <- p + geom_ribbon(
data = to_plot_data,
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation,
fill = experiment
), colour = NA, alpha = 0.3
) + geom_line(
data = to_plot_data
)
}
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
data_per_ppt <- init_learning_rates %>%
filter(
experiment != "a_ball_roll_animate_surface",
test_type != "transfer_init"
)
data_per_group <- data_per_ppt %>%
group_by(experiment, test_type) %>%
summarise(
mean_learning_rate = mean(exp_fit_lambda),
ci_learning_rate = vector_confint(exp_fit_lambda),
mean_high = mean(exp_fit_N0),
ci_high = vector_confint(exp_fit_N0),
.groups = "drop"
)
p <- data_per_group %>%
ggplot(
aes(x = experiment, y = mean_learning_rate, colour = experiment)
) +
theme_classic() +
labs(
x = NULL,
y = "Learning Rate"
) +
facet_wrap(~test_type)
# remove all x axis labels
p <- p + theme(axis.text.x = element_blank())
# for the colour legend, only show the first 7
# Note this doesn't work for the plotly plot
p <- p + guides(colour = guide_legend(override.aes = list(alpha = 1)))
# add data points
p <- p +
geom_beeswarm(
data = data_per_ppt,
aes(
y = exp_fit_lambda
),
alpha = 0.1,
size = 1
) +
geom_linerange(aes(
ymin = mean_learning_rate - ci_learning_rate,
ymax = mean_learning_rate + ci_learning_rate
), alpha = 0.5, lwd = 2) +
geom_point()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# p
p <- data_per_group %>%
ggplot(
aes(x = experiment, y = mean_high, colour = experiment)
) +
theme_classic() +
labs(
x = NULL,
y = "High Point"
) +
facet_wrap(~test_type)
# remove all x axis labels
p <- p + theme(axis.text.x = element_blank())
# for the colour legend, only show the first 7
# Note this doesn't work for the plotly plot
p <- p + guides(colour = guide_legend(override.aes = list(alpha = 1)))
# add data points
p <- p +
geom_beeswarm(
data = data_per_ppt,
aes(
y = exp_fit_N0
),
alpha = 0.1,
size = 1
) +
geom_linerange(aes(
ymin = mean_high - ci_high,
ymax = mean_high + ci_high
), alpha = 0.5, lwd = 2) +
geom_point()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# p
For washout: The CUED accel + curved have a lower starting point (therefore – cue works). VMR group has slightly lower. When comparing everything with a high starting point, the ACCEL group has a much FASTER learning rate.
# Compare learning rates and high points
p <- data_per_ppt %>%
ggplot(
aes(x = exp_fit_lambda, y = exp_fit_N0, colour = experiment)
) +
theme_classic() +
labs(
x = "Learning Rate",
y = "High Point"
) +
facet_wrap(~test_type) +
geom_point() +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
data_per_ppt <- init_learning_rates_3par %>%
filter(
experiment != "a_ball_roll_animate_surface",
test_type == "transfer_init"
)
data_per_group <- data_per_ppt %>%
group_by(experiment, test_type) %>%
summarise(
mean_learning_rate = mean(exp_fit_lambda),
ci_learning_rate = vector_confint(exp_fit_lambda),
mean_high = mean(exp_fit_N0),
ci_high = vector_confint(exp_fit_N0),
mean_low = mean(exp_fit_displace),
ci_low = vector_confint(exp_fit_displace),
.groups = "drop"
)
p <- data_per_group %>%
ggplot(
aes(x = experiment, y = mean_learning_rate, colour = experiment)
) +
theme_classic() +
labs(
x = NULL,
y = "Learning Rate"
) +
facet_wrap(~test_type)
# remove all x axis labels
p <- p + theme(axis.text.x = element_blank())
# for the colour legend, only show the first 7
# Note this doesn't work for the plotly plot
p <- p + guides(colour = guide_legend(override.aes = list(alpha = 1)))
# add data points
p <- p +
geom_beeswarm(
data = data_per_ppt,
aes(
y = exp_fit_lambda
),
alpha = 0.1,
size = 1
) +
geom_linerange(aes(
ymin = mean_learning_rate - ci_learning_rate,
ymax = mean_learning_rate + ci_learning_rate
), alpha = 0.5, lwd = 2) +
geom_point()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# p
p <- data_per_group %>%
ggplot(
aes(x = experiment, y = mean_high, colour = experiment)
) +
theme_classic() +
labs(
x = NULL,
y = "High Point (Asymptotes)"
) +
facet_wrap(~test_type)
# remove all x axis labels
p <- p + theme(axis.text.x = element_blank())
# for the colour legend, only show the first 7
# Note this doesn't work for the plotly plot
p <- p + guides(colour = guide_legend(override.aes = list(alpha = 1)))
# add data points
p <- p +
geom_beeswarm(
data = data_per_ppt,
aes(
y = exp_fit_N0
),
alpha = 0.1,
size = 1
) +
geom_linerange(aes(
ymin = mean_high - ci_high,
ymax = mean_high + ci_high
), alpha = 0.5, lwd = 2) +
geom_point()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# p
p <- data_per_group %>%
ggplot(
aes(x = experiment, y = mean_low, colour = experiment)
) +
theme_classic() +
labs(
x = NULL,
y = "Low Point (Starts)"
) +
facet_wrap(~test_type)
# remove all x axis labels
p <- p + theme(axis.text.x = element_blank())
# for the colour legend, only show the first 7
# Note this doesn't work for the plotly plot
p <- p + guides(colour = guide_legend(override.aes = list(alpha = 1)))
# add data points
p <- p +
geom_beeswarm(
data = data_per_ppt,
aes(
y = exp_fit_displace
),
alpha = 0.1,
size = 1
) +
geom_linerange(aes(
ymin = mean_low - ci_low,
ymax = mean_low + ci_low
), alpha = 0.5, lwd = 2) +
geom_point()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# p
When transferring, what happens?
# 3d plot of learning rates, high points, and low points
# filter out just the washout trials for now
data_per_ppt <- init_learning_rates_3par %>%
filter(test_type == "transfer_init")
p <- plot_ly(type = "scatter3d", mode = "markers")
for (experiment_ in unique(data_per_ppt$experiment)) {
# get the data for this block
to_plot_data <- filter(data_per_ppt, experiment == experiment_)
p <- p %>%
add_trace(
x = to_plot_data$exp_fit_lambda,
y = to_plot_data$exp_fit_N0,
z = to_plot_data$exp_fit_displace,
color = I(pallete_list[experiment_]),
name = experiment_
)
}
# Axes names
p <- p %>% layout(
scene =
(list(
xaxis = list(title = "Learning Rate"),
yaxis = list(title = "High Point"),
zaxis = list(title = "Low Point"),
aspectmode = "cube" # equal aspect ratios
))
)
p
### Error Size ###
# rest of the exps
data_per_ppt <- omnibus_df %>%
filter(experiment == "accel_uncued", test_type == "washout_init")
# set up plot
p <- data_per_ppt %>%
ggplot(
aes(
x = trial_num, y = norm_throw_deviation, colour = ppid
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Normalized Throw Angle"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, 1, 2), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(0.5, 1.5), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# set font size to 11
p <- p +
theme(text = element_text(size = 11))
# add confidence intervals and data points
p <- p + geom_line()
ggplotly(p)
# p
Note: Blues = Acceleration Perturbations
# original experiments only
data_per_group <- omnibus_df %>%
filter(exp_label == "original_exps" | exp_label == "curved_path") %>%
group_by(experiment, test_type, trial_num) %>%
summarise(
mean_deviation = mean(error_size),
ci_deviation = vector_confint(error_size),
.groups = "drop"
)
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = trial_num, y = mean_deviation, colour = experiment
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Absolute Target Error (cm)"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, 40), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(20), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# set font size to 11
p <- p +
theme(text = element_text(size = 11))
# add confidence intervals and data points
p <- p + geom_ribbon(
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation,
fill = experiment
),
colour = NA, alpha = 0.3
) + geom_line()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# p
visible vs non-visible tilt doesn’t affect the 15-degree rotation condition. But affects all other conditions. So 15-degree rotation
Note: Blues = Acceleration Perturbations
# filter out just the trials of interest
data_per_group <- data_per_group %>%
filter(
test_type != "other"
)
# add a dummy column with repeating sequence
# NOTE: this can't be combined with above since we are using nrow
data_per_group <- data_per_group %>%
mutate(dummy_x = rep(1:(nrow(data_per_group) / num_exps),
length.out = nrow(data_per_group)
))
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = dummy_x, y = mean_deviation, colour = experiment
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Absolute Target Error (cm)"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, 40), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(20), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# add confidence intervals and data points
for (unique_test_type in unique(data_per_group$test_type)) {
# get the data for this block
to_plot_data <- filter(data_per_group, test_type == unique_test_type)
p <- p + geom_ribbon(
data = to_plot_data,
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation,
fill = experiment
), colour = NA, alpha = 0.3
) + geom_line(
data = to_plot_data
)
}
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# isolate animate_surface exp
data_per_group <- omnibus_df %>%
filter(exp_label == "animate_surface") %>%
group_by(prior_anim, block_num, trial_num_in_block, trial_num) %>%
summarise(
mean_deviation = mean(throw_deviation),
ci_deviation = vector_confint(throw_deviation)
)
# order the factors for assigning colour pallets
data_per_group$prior_anim <- factor(
data_per_group$prior_anim,
levels = c(
"none", "half_anim", "full_anim"
)
)
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = trial_num, y = mean_deviation,
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number",
y = "Throw Angle (°)"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, -30), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(-15), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# set font size to 11
p <- p +
theme(text = element_text(size = 11))
# repeat for prior_anim == "half", "full" and "wait"
for (unique_prior_anim in unique(data_per_group$prior_anim)) {
# get the data for this block
to_plot_data <- filter(data_per_group, prior_anim == unique_prior_anim)
# loop through the unique blocks in to_plot_data
for (block in unique(to_plot_data$block_num)) {
# get the data for this block
block_data <- filter(to_plot_data, block_num == block)
# add the data, use the pallete_list to get the colour
p <- p + geom_ribbon(
data = block_data,
aes(fill = prior_anim),
colour = NA, alpha = 0.3
) + geom_line(
data = block_data,
aes(colour = prior_anim)
)
}
}
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# p
# first, isolate the data
data_per_ppt_anim <- omnibus_df %>%
filter(
exp_label == "animate_surface",
baseline_block == FALSE,
test_type == "washout_anim"
) %>%
group_by(ppid, prior_anim, trial_num_in_block) %>%
summarise(
ppt_median_deviation = median(throw_deviation),
.groups = "drop"
) %>% # prior_anim rename to experiment (to match the other comparisons)
mutate(
experiment = prior_anim,
throw_deviation = ppt_median_deviation
) %>%
select(-prior_anim, -ppt_median_deviation)
data_per_group <- data_per_ppt_anim %>%
group_by(experiment, trial_num_in_block) %>%
summarise(
mean_deviation = mean(throw_deviation),
ci_deviation = vector_confint(throw_deviation),
n = n()
)
# set up plot
p <- data_per_group %>%
ggplot(
aes(
x = trial_num_in_block, y = mean_deviation,
colour = experiment, fill = experiment
)
) +
theme_classic() +
# theme(legend.position = "none") +
labs(
x = "Trial Number in Block",
y = "Throw Angle (°)"
)
# add horizontal lines
p <- p +
geom_hline(
yintercept = c(0, -30), linewidth = 0.4,
colour = "#CCCCCC", linetype = "solid"
) +
geom_hline(
yintercept = c(-15), linewidth = 0.4,
colour = "#CCCCCC", linetype = "dashed"
)
# add data points
p <- p +
geom_ribbon(
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation
),
colour = NA, alpha = 0.3
) +
geom_line()
# add washout_init from the 30-degree rotation condition
data_per_ppt_30 <- omnibus_df %>%
filter(
experiment %in% c("rot30_cued_tilt", "rot30_uncued"),
test_type == "washout_init",
trial_num_in_block <= 8
) %>%
select(ppid, trial_num_in_block, experiment, throw_deviation)
data_per_group_30 <- data_per_ppt_30 %>%
group_by(experiment, trial_num_in_block) %>%
summarise(
mean_deviation = mean(throw_deviation),
ci_deviation = vector_confint(throw_deviation),
n = n(),
.groups = "drop"
)
# add data points
p <- p +
geom_ribbon(
data = data_per_group_30,
aes(
ymin = mean_deviation - ci_deviation,
ymax = mean_deviation + ci_deviation,
fill = experiment
),
colour = NA, alpha = 0.3
) +
geom_line(
data = data_per_group_30,
aes(
colour = experiment
)
)
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# rbind data_per_ppt_anim and data_per_ppt_30
anim_comparison_df <- rbind(
data_per_ppt_anim,
data_per_ppt_30
)
# remove data_per_ppt_anim and data_per_ppt_30
rm(data_per_ppt_anim, data_per_ppt_30)
# Optionally compute learning rate fits
# Do if learning_rate_df_anim.csv doesn't exist in ../data/processed
if (!file.exists("../data/processed/learning_rate_df_anim.csv")) {
print(Sys.time())
apply_exponential_fit <- function(df) {
df %>%
summarise(
ppid = first(ppid),
experiment = first(experiment),
exponentialFit = exponentialFit(throw_deviation,
mode = "washout_init"
)
)
}
anim_learning_rates <- anim_comparison_df %>%
group_by(ppid, experiment) %>%
group_split() %>%
future_map(apply_exponential_fit) %>%
bind_rows() %>%
unnest(cols = c("exponentialFit"))
print("done 2 param fits")
print(Sys.time())
write_csv(
anim_learning_rates,
"../data/processed/learning_rate_df_anim.csv"
)
} else {
anim_learning_rates <- read_csv(
"../data/processed/learning_rate_df_anim.csv",
col_types = cols(
.default = col_double(),
ppid = col_factor(),
experiment = col_factor()
)
)
}
data_per_ppt <- anim_learning_rates
data_per_group <- data_per_ppt %>%
group_by(experiment) %>%
summarise(
mean_learning_rate = mean(exp_fit_lambda),
ci_learning_rate = vector_confint(exp_fit_lambda),
mean_high = mean(exp_fit_N0),
ci_high = vector_confint(exp_fit_N0),
.groups = "drop"
)
p <- data_per_group %>%
ggplot(
aes(x = experiment, y = mean_learning_rate, colour = experiment)
) +
theme_classic() +
labs(
x = NULL,
y = "Learning Rate"
)
# remove all x axis labels
p <- p + theme(axis.text.x = element_blank())
# for the colour legend, only show the first 7
# Note this doesn't work for the plotly plot
p <- p + guides(colour = guide_legend(override.aes = list(alpha = 1)))
# add data points
p <- p +
geom_beeswarm(
data = data_per_ppt,
aes(
y = exp_fit_lambda
),
alpha = 0.1,
size = 1
) +
geom_linerange(aes(
ymin = mean_learning_rate - ci_learning_rate,
ymax = mean_learning_rate + ci_learning_rate
), alpha = 0.5, lwd = 2) +
geom_point()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# p
p <- data_per_group %>%
ggplot(
aes(x = experiment, y = mean_high, colour = experiment)
) +
theme_classic() +
labs(
x = NULL,
y = "Start Point"
)
# remove all x axis labels
p <- p + theme(axis.text.x = element_blank())
# for the colour legend, only show the first 7
# Note this doesn't work for the plotly plot
p <- p + guides(colour = guide_legend(override.aes = list(alpha = 1)))
# add data points
p <- p +
geom_beeswarm(
data = data_per_ppt,
aes(
y = exp_fit_N0
),
alpha = 0.1,
size = 1
) +
geom_linerange(aes(
ymin = mean_high - ci_high,
ymax = mean_high + ci_high
), alpha = 0.5, lwd = 2) +
geom_point()
# set colour palette
p <- p +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
# p
# Compare learning rates and high points
p <- data_per_ppt %>%
ggplot(
aes(x = exp_fit_lambda, y = exp_fit_N0, colour = experiment)
) +
theme_classic() +
labs(
x = "Learning Rate",
y = "High Point (Starts)"
) +
geom_point() +
scale_colour_manual(values = pallete_list) +
scale_fill_manual(values = pallete_list)
ggplotly(p)
plot_success_manifold_no_tilt()
plot_success_manifold_tilt()